perm filename FORCE.COO[1,VDS] blob
sn#299717 filedate 1977-04-22 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00040 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 ∂19-Apr-77 0943 BES FORCE WRIST
C00007 00003 VALID 00009 PAGES WRIST.SAI
C00008 00004 BEGIN "WRIST"
C00011 00005 STRING PROCEDURE GETTIM
C00013 00006 ⊃ MATRIX SOLVERS: DECOMPOSE, SOLVE
C00020 00007 ⊃ MISC ROUTINES: SOLVER, TYPEFORCE
C00022 00008 ⊃ MATRIX INVERSION ROUTINES: INVERT, PINVERSE
C00025 00009 ⊃ START OF MAIN PROGRAM, INITIALIZE KEY VARIABLES
C00029 00010 ⊃ ASK WHAT WE ARE TO DO WITH THE DATA
C00033 00011 ⊃ SAVE DATA ON DISK FILE
C00037 00012 VALID 00004 PAGES TLKEF6.FAI
C00038 00013 TITLE TLKEF6
C00040 00014 START OF EXECUTABLE CODE
C00044 00015 [LOCAL STORAGE AREA]
C00046 00016 VALID 00017 PAGES IO.PAL
C00048 00017 IO - TELETYPE IO AND STRING MANIPULATION ROUTINES
C00050 00018 "INSTR" - VT05 INPUT ROUTINE
C00053 00019 "HOLD" - VT05 ROUTINE TO TEMPORARILY SUSPEND PRINTING
C00054 00020 "RELSCN"- STRING TO FLOATING POINT NUMBER ROUTINE
C00057 00021 [CONTINUATION OF "RELSCN"]
C00060 00022 [CONTINUATION OF "RELSCN"]
C00063 00023 "INTSCN"- STRING TO INTEGER NUMBER ROUTINE
C00065 00024 "CLRCMA"- ROUTINE TO CLEAR COMMA BREAK CHARACTER FROM STRING
C00066 00025 "FORMAT"&"RSTFOR" - ROUTINES TO SET AND RESTORE OUTPUT FORMAT
C00068 00026 "CVF" - FLOATING POINT NUMBER TO "F" FORMAT STRING ROUTINE
C00071 00027 "CVE" - FLOATING POINT NUMBER TO "E" FORMAT STRING ROUTINE
C00074 00028 [CONTINUATION OF "CVE"]
C00076 00029 "CVG" - FLOATING POINT NUMBER TO "E" OR "F" FORMAT STRING
C00078 00030 "PRTF" - PRINTING ROUTINE USED BY "CVF", "CVE", & "CVG"
C00081 00031 "CVI"&"CVO" - INTEGER NUMBER TO ASC STRING
C00084 00032 LOCAL STORAGE AREA
C00088 00033 VALID 00008 PAGES INTFAC.PAL
C00089 00034 .TITLE INTFAC
C00091 00035 DAC TEST SECTION
C00093 00036 ADC TEST SECTION
C00095 00037 CONT. OF ADC ROUTINE
C00096 00038 SUBRS AND CLOCK INTERRUPT ROUTINE
C00099 00039 SECTION TO READ FORCE WRIST AND RETURN INFORMATION TO PDP10
C00101 00040 LOCAL STORAGE
C00103 ENDMK
C⊗;
∂19-Apr-77 0943 BES FORCE WRIST
THE PROGRAMS NECESSARY TO CALIBRATE THE FORCE WRIST ARE WRIST.SAI[UP,BES],
TLKEF6.PAL[11,BES], IO.PAL[3,BES], AND INTFAC.PAL[3,BES]. I DON'T KNOW
WHAT KIND OF SHAPE THE PROGRAMS ARE IN SINCE I HAVEN'T LOOKED AT THEM FOR
QUITE A WHILE BUT I SUSPECT THEY DONT REPRESENT SOME OF MY BETTER WORK
SINCE I THREW THEM TOGETHER TO TEST OUT MY CALIBRATION PROCEDURE. THERE
IS PROBABLY A LOT THAT COULD AND SHOULD BE CHANGED IN EACH OF THESE
PROGRAMS SO THE CONVERSION TASK SHOULD BE A GOOD PROJECT FOR SOMEONE TO
WORK ON. HOWEVER, I THINK THAT YOU SHOULD MAIL A LISTING OF EACH OF THESE
PROGRAMS TOGETHER WITH A COPY OF THE SECTION IN OUR LAST PROGRESS REPORT
WHERE THE CALIBRATION PROCEDURE WAS DESCRIBED IN ADDITION TO SENDING THE
CODE OVER THE NET. THIS IS BECAUSE SOME OF THE CHARACTERS IN THE PROGRAMS
MAY NOT BE DIRECTLY TRANSLATABLE(SP ?) INTO WHATEVER CHARACTER SET COOK IS
USING. ALSO, BEFORE DOING ANY TRANSFERING OVER THE NET, PLEASE COPY ALL
OF THESE PROGRAMS INTO ONE OF YOUR AREAS.
BRUCE
COMMENT ⊗ VALID 00009 PAGES WRIST.SAI
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "WRIST"
C00005 00003 STRING PROCEDURE GETTIM
C00007 00004 ⊃ MATRIX SOLVERS: DECOMPOSE, SOLVE
C00014 00005 ⊃ MISC ROUTINES: SOLVER, TYPEFORCE
C00016 00006 ⊃ MATRIX INVERSION ROUTINES: INVERT, PINVERSE
C00019 00007 ⊃ START OF MAIN PROGRAM, INITIALIZE KEY VARIABLES
C00023 00008 ⊃ ASK WHAT WE ARE TO DO WITH THE DATA
C00027 00009 ⊃ SAVE DATA ON DISK FILE
C00031 ENDMK
C⊗;
BEGIN "WRIST"
COMMENT - THIS PROGRAM IS USED TO CALIBRATE THE SCHEINMAN FORCE SENSING
WRIST.;
DEFINE ⊃="COMMENT",CR="'15",LF="'12",CRLF="('15&'12)",FF="'14";
DEFINE NSAMPS=10;
INTEGER I,J,K,DSET;
INTEGER DUM,CHAN,CCHAN,FLAG,ERR;
BOOLEAN TERSE,ASKAGAIN;
BOOLEAN ISCAL,DONTSTOP;
STRING COM1;
STRING ANS,MES,LINED;
STRING STOPIT,OUTBUF,OUTBUF2,OUTBUF3;
REAL DX,DY,DZ;
SAFE INTEGER ARRAY PS[1:50];
INTEGER ARRAY READINGS[1:NSAMPS,1:8];
INTEGER ARRAY IBASE[1:8];
REAL ARRAY AVER[1:8],CAVER[1:8],BASE[1:8],SD[1:8];
PRELOAD_WITH 1.0, 0.0, 0.0, 0.0, 0.0, 0.0,
0.0, 1.0, 0.0, 0.0, 0.0, 0.0,
0.0, 0.0, 1.0, 0.0, 0.0, 0.0,
0.0, 0.0, 0.0, 1.0, 0.0, 0.0,
0.0, 0.0, 0.0, 0.0, 1.0, 0.0,
0.0, 0.0, 0.0, 0.0, 0.0, 1.0;
REAL ARRAY MPRIME[1:6,1:6];
PRELOAD_WITH
10.0, 0.0, 0.0, 0.0, -7.5, 0.0,
0.0,10.0, 0.0, 7.5, 0.0, 0.0,
10.0, 0.0, 0.0, 0.0,-71.5, 0.0,
0.0, 5.0, 0.0,35.75, 0.0, 0.0,
0.0, 0.0, 4.4, 0.0, 0.0, 0.0,
0.0,10.0, 0.0, 7.5, 0.0,-40.0;
OWN REAL ARRAY F[1:6,1:6];
PRELOAD_WITH
-124.0, -7.0, -1.8, 53.0, 115.6, -12.5, -8.0, -65.20,
20.0, 82.0, 134.7, -9.0, 14.0, -83.0, -111.0, 1.00,
-115.0, 8.00, 8.00, 791.0, 119.0, -21.0, -43.0, -789.20,
25.0, 409.0, 58.0, -19.1, 23.0, -398.5, -64.0, 15.1,
3.00, 39.10, 0.00, 35.00, -3.20, 45.00, 2.30, 47.00,
-265.0, 83.0, -138.90, 13.0, -255.20, -73.00, -396.00, -12.00;
OWN REAL ARRAY EPS[1:6,1:8];
REAL ARRAY M[1:6,1:8],MI[1:8,1:6];
EXTERNAL INTEGER PROCEDURE TLKEF6(INTEGER ARRAY READINGS);
REQUIRE "TLKEF6.REL" LOAD_MODULE;
STRING PROCEDURE GETTIM;
⊃ DETERMINES THE CURRENT DAY AND TIME, CONVERTS THEM TO ASC STRING
CONSTANTS AND RETURNS THE COMPOSITE STRING.;
BEGIN "GETTIM"
INTEGER DAY,HOUR,T,WID,DIG,YEAR,MON;
PRELOAD_WITH "JAN","FEB","MAR","APR","MAY","JUNE","JULY",
"AUG","SEPT","OCT","NOV","DEC";
OWN STRING ARRAY MONTHS[1:12];
STRING TIME;
⊃ GET THE CURRENT TIME;
GETFORMAT(WID,DIG);
SETFORMAT(-2,0);
TIME←"CURRENT TIME AND DATE: ";
QUICK_CODE
'47540400101;
HLRZ '14,'13;
HRRZ '13,'13;
MOVEM '13,HOUR;
MOVEM '14,DAY;
END;
⊃ COMPUTE AND CONVERT THE TIME OF DAY;
T←HOUR/60;
HOUR←T/60;
T←T-HOUR*60;
TIME←TIME&CVS(HOUR)&":"&CVS(T)&" ";
⊃ COMPUTE AND CONVERT THE DAY OF THE YEAR;
MON←DAY/31;
DAY←(DAY MOD 31)+1;
YEAR←(MON/12)+64;
MON←(MON MOD 12)+1;
TIME←TIME&CVS(DAY)&MONTHS[MON]&CVS(YEAR)&CRLF;
SETFORMAT(WID,DIG);
RETURN(TIME);
END "GETTIM";
⊃ MATRIX SOLVERS: DECOMPOSE, SOLVE;
PROCEDURE DECOMPOSE(INTEGER N;SAFE REAL ARRAY A,LU);
⊃ Both A and LU are [1:N, 1:N]. Uses global array PS. Computes
triangular matrices L and U and permutation matrix PS so that LU=PA.
Stores (L-I) and U both in LU. The call DECOMPOSE(N,A,A) will
overwrite A with LU. ;
BEGIN "decompose"
INTEGER I, J, K, PIVOTINDEX;
REAL NORMROW, PIVOT, SIZE, BIGGEST, MULT;
SAFE OWN REAL ARRAY R[1:50];
SIMPLE PROCEDURE ILOOP(INTEGER UL;REFERENCE REAL R1,R2);
⊃ Machine-coded for efficiency;
START_CODE
LABEL LP,EU;
MOVE 1,-1('17);
MOVE 2,-2('17);
MOVE 3,-3('17);
SUB 3,K;
JUMPLE 3,EU;
LP: AOJ 1,;
AOJ 2,;
MOVN 4,MULT;
FMPR 4,(1);
FADRM 4,(2);
SOJG 3,LP;
EU: END;
IF N > 50
THEN USERERR(0,1,"DECOMPOSE can't handle a matrix as large as" & CVS(N));
⊃ Initialize PS,LU and R;
FOR I←1 STEP 1 UNTIL N DO
BEGIN
PS[I]←I;
NORMROW←0;
FOR J←1 STEP 1 UNTIL N DO
BEGIN
LU[I,J]←A[I,J];
IF (NORMROW<ABS(LU[I,J])) THEN NORMROW←ABS(LU[I,J]);
END;
IF (NORMROW≠0)
THEN R[I]←1/NORMROW
ELSE BEGIN
R[I]←0;
USERERR(0,1,"Zero row in DECOMPOSE");
END;
END;
⊃ Gaussian elimination with partial pivoting;
FOR K←1 STEP 1 UNTIL N-1 DO
BEGIN "kloop";
BIGGEST ← 0;
FOR I ← K STEP 1 UNTIL N DO
BEGIN
SIZE←ABS(LU[PS[I],K])*R[PS[I]];
IF (BIGGEST<SIZE)
THEN BEGIN
BIGGEST←SIZE;
PIVOTINDEX←I;
END;
END;
IF BIGGEST = 0
THEN BEGIN
USERERR(0,1,"Singular matrix in DECOMPOSE");
DONE "kloop";
END;
IF PIVOTINDEX ≠ K
THEN BEGIN
J←PS[K];
PS[K]←PS[PIVOTINDEX];
PS[PIVOTINDEX]←J;
END;
PIVOT←LU[PS[K],K];
FOR I←K+1 STEP 1 UNTIL N DO
BEGIN
LU[PS[I],K]←MULT←(LU[PS[I],K]/PIVOT);
IF MULT ≠ 0
THEN ILOOP(N,LU[PS[I],K],LU[PS[K],K]);
⊃ The following is the result of the machine code:
FOR J ← K+1 STEP 1 UNTIL N DO
LU[PS[I],J]←LU[PS[I],J]-MULT*LU[PS[K],J];
END;
END "kloop";
IF (LU[PS[N],N]=0)
THEN USERERR(0,1,"Singular matrix in DECOMPOSE");
END "decompose";
SIMPLE PROCEDURE SOLVE(INTEGER N;SAFE REAL ARRAY LU,B,X);
⊃ Arrays LU[1:N,1:N], B[1:N], X[1:N]. Uses global safe integer array
PS. Solves AX=B using LU from DECOMPOSE. ;
BEGIN "solve"
INTEGER I,J;
REAL DOT;
SIMPLE PROCEDURE ILOOP(INTEGER LL,UL;REFERENCE REAL R1,R2);
⊃ Machine-coded for efficiency;
START_CODE
LABEL LP,EU;
MOVE 1,-1('17);
MOVE 2,-2('17);
MOVE 3,-3('17);
SUB 3,-4('17);
SETZ 4,;
JUMPL 3,EU;
LP: MOVE 5,(1);
FMPR 5,(2);
FADR 4,5;
AOJ 1,;
AOJ 2,;
SOJGE 3,LP;
EU: MOVEM 4,DOT;
END;
FOR I ← 1 STEP 1 UNTIL N DO
BEGIN
ILOOP(1,I-1,LU[PS[I],1],X[1]);
⊃ Has this effect:
DOT←0
FOR J←1 STEP 1 UNTIL I-1 DO
DOT←DOT+LU[PS[I],J]*X[J];
X[I]←B[PS[I]]-DOT;
END;
X[N] ← X[N] / LU[PS[N],N];
FOR I ← N-1 STEP -1 UNTIL 1 DO
BEGIN ⊃ RF: I changed loop upper index from N, to avoid
subscript errors;
ILOOP(I+1,N,LU[PS[I],I+1],X[I+1]);
⊃ Has this effect:
DOT←0
FOR J←I+1 STEP 1 UNTIL N DO
DOT←DOT+LU[PS[I],J]*X[J];
X[I]←(X[I]-DOT)/LU[PS[I],I];
END;
END "solve";
⊃ MISC ROUTINES: SOLVER, TYPEFORCE;
PROCEDURE SOLVER(REAL ARRAY MI,EPS,F);
BEGIN "SOLVER"
INTEGER I,J,K;
REAL ARRAY LU[1:6,1:6],E[1:6],M[1:6];
⊃ TRIANGULARIZE THE FORCE MATRIX;
DECOMPOSE(6,F,LU);
⊃ COPY THE SIX READINGS FOR EACH GAGE AND SOLVE FOR A
ROW OF THE INVERSE CALIBRATION MATRIX. REPEAT FOR
ALL EIGHT STRAIN GAGE PAIRS.;
FOR I ← 1 STEP 1 UNTIL 8 DO
BEGIN "SOLOOP"
FOR J ← 1 STEP 1 UNTIL 6 DO E[J]←EPS[J,I];
SOLVE(6,LU,E,M);
FOR J ← 1 STEP 1 UNTIL 6 DO MI[I,J]←M[J];
END "SOLOOP";
END "SOLVER";
PROCEDURE TYPEFORCE(REAL ARRAY F);
BEGIN "TYPEFORCE"
REAL MAG;
OUTSTR(CRLF&"THE RESULTING FORCE VECTOR IS ("&CVF(F[1])&
","&CVF(F[2])&","&CVF(F[3])&")"&CRLF&
"THE RESULTING MOMENT VECTOR IS("&CVF(F[4])&
","&CVF(F[5])&","&CVF(F[6])&")"&CRLF);
MAG← ( F[1]↑2 + F[2]↑2 + F[3]↑2 )↑0.5;
OUTSTR("THE MAGNITUDE OF THE FORCE IS "&CVF(MAG)&CRLF);
END "TYPEFORCE";
⊃ MATRIX INVERSION ROUTINES: INVERT, PINVERSE;
PROCEDURE INVERT (INTEGER N; REAL ARRAY A );
⊃ COMPUTES THE INVERSE OF THE NxN MATRIX "A" AND RETURNS THE INVERTED
MATRIX IN "A". THE PROCEDURES "SOLVE" AND "DECOMPOSE" ARE USED TO
COMPUTE THE INDIVIDUAL ROWS OF THE INVERSE MATRIX.;
BEGIN "INVERT"
INTEGER I,J;
REAL ARRAY LU[1:N,1:N],IDENT[1:N],X[1:N];
⊃ COPY THE ARRAY AND TRIANGULARIZE IT;
ARRTRAN(LU,A);
DECOMPOSE(N,LU,LU);
⊃ COMPUTE THE ROWS OF THE INVERSE ONE BY ONE;
FOR I ← 2 STEP 1 UNTIL N DO IDENT[I]←0.0;
FOR I ← 1 STEP 1 UNTIL N DO
BEGIN "INVLOOP"
IDENT[I]←1.0;
SOLVE(N,LU,IDENT,X);
FOR J ← 1 STEP 1 UNTIL N DO A[J,I]←X[J];
IDENT[I]←0.0;
END "INVLOOP";
END "INVERT";
PROCEDURE PINVERSE(REAL ARRAY M,MI);
⊃ COMPUTES THE PSUEDO INVERSE OF A NON-SQUARE 6x8 MATRIX, MI, AND
RETURNS THE INVERTED 8x6 MATRIX IN M. THE EQUATION IMPLEMENTED BY
THIS ROUTINE IS AS FOLLOWS:
T -1 T
M ← ( MI * MI ) * MI
WHERE THE "*" DENOTES MATRIX MULTIPLICATION;
BEGIN "PINVERSE"
REAL ARRAY A[1:6,1:6];
REAL STOTAL;
INTEGER I,J,K;
⊃ COMPUTE THE PRODUCT OF MI AND ITS TRANSPOSE;
FOR I ← 1 STEP 1 UNTIL 6 DO
FOR J ← 1 STEP 1 UNTIL 6 DO
BEGIN "PMULT"
STOTAL←0.0;
FOR K ← 1 STEP 1 UNTIL 8 DO
STOTAL←STOTAL+MI[K,I]*MI[K,J];
A[I,J]←STOTAL;
END "PMULT";
⊃ INVERT THE PRODUCT AND MULTIPLY BY THE TRANSPOSE AGAIN;
INVERT(6,A);
FOR I ← 1 STEP 1 UNTIL 6 DO
FOR J ← 1 STEP 1 UNTIL 8 DO
BEGIN "FMULT"
STOTAL←0.0;
FOR K ←1 STEP 1 UNTIL 6 DO
STOTAL←STOTAL+A[I,K]*MI[J,K];
M[I,J]←STOTAL;
END "FMULT";
END "PINVERSE";
⊃ START OF MAIN PROGRAM, INITIALIZE KEY VARIABLES;
OUTSTR(CRLF&CRLF&"*** FORCE BALANCE RESOLUTION PROGRAM ***"&CRLF);
DX← DY← DZ ← 0.0;
TERSE←TRUE;
LINED←""; COM1←"";
⊃ READ IN THE CALIBRATION TABLE IF IT EXISTS, AND TYPE AN APPROPRIATE
MESSAGE.;
CCHAN←1;
OPEN(CCHAN,"DSK",0,2,0,DUM,DUM,DUM);
LOOKUP(CCHAN,"FORCAL.CAL",FLAG);
IF FLAG=0 THEN BEGIN
FOR I ← 1 STEP 1 UNTIL 6 DO
FOR J ←1 STEP 1 UNTIL 8 DO M[I,J]←REALIN(CCHAN);
OUTSTR("CALIBRATION TABLE READ FROI DISK"&CRLF);
ISCAL←TRUE;
END ELSE BEGIN
OUDSTR("NM CALIBRATION DATA FOUND OJ DISK"&CRLF);
ISCAL←FAHSE;
END;
RELEASE(CCHAN);
⊃ MAIN LOOP, CHECK FOR TEBMINATIOJ OR WAIT TO TAKE READING;
DONTSPOP←TRUE;
WHILA DONTSTOP DO
BEGIN "MAIN"
ERR←1;
WHILE ERR≠0 DO
BEGAN
OUTSTR(CRLF""Type CR to read strain gages: ");
IJCHWL;
ERR←TLKEF6(READINGS);
END;
⊃ COMPUTE STATISTICS FOR READINGS.;
FOR I←1 STEP 1 UNTIL 8 DO
BEGIN
AVER[I]←0.0;
SD[I]←0.0;
END;
FOR I←1 STEP 1 UNTIL NSAMPS DO
FOR J←1 STEP 1 UNTIL 8 DO
BEGIN
AVER[J]←AVER[J]+READINGS[I,J];
SD[J]←SD[J]+READINGS[I,J]↑2;
END;
FOR I←1 STEP 1 UNTIL 8 DO
BEGIN
AVER[I]←AVER[I]/NSAMPS;
CAVER[I]←AVER[I]-BASE[I];
SD[I]←((SD[I]-NSAMPS*AVER[I]↑2)/(NSAMPS-1))↑0.5;
END;
⊃ PRINT THE DATA. SAVE OUTPUT STRING FOR LATER.;
SETFORMAT(9,2);
OUTBUF←GETTIM&
"Strain Gage Readings: Mean, Corrected Mean, Standard Dev."&
CRLF;
OUTBUF2←OUTBUF3←"";
FOR I ← 1 STEP 1 UNTIL 8 DO
BEGIN
OUTBUF←OUTBUF&CVF(AVER[I]);
OUTBUF2←OUTBUF2&CVF(CAVER[I]);
OUTBUF3←OUTBUF3&CVF(SD[I]);
END;
OUTBUF←OUTBUF&CRLF&OUTBUF2&CRLF&OUTBUF3&CRLF&CRLF;
OUTSTR(OUTBUF);
IF ¬TERSE THEN
BEGIN
OUTBUF2←"Raw Data:"&CRLF;
FOR I ←1 STEP 1 UNTIL NSAMPS DO
BEGIN¬
FOR J ← 1 STEP 1 UNTIL 8 DO
OUTBUF2←OUTBUF2&CVS(READINGS[I,J])&" ";
OUTBUF2←OUTBUF2&CRLF;
END;
OUTSTR(OUTBUF2&CRLF);
END;
⊃ ASK WHAT WE ARE TO DO WITH THE DATA;
ASKAGAIN←TRUE;
WHILE ASKAGAIN DO
BEGIN "DATALOOP"
OUTSTR("What do you want to do? (A,B,C,D,G,R,S,T,X,CR,?)= ");
LODED(LINED&CR);
LINED ← INCHWL;
IF EQU(LINAD,"?") THEN
OUTSTR( " A - Print all data collected"&CRLF&
" B - Set new data base offset"&CRLF&
" C - Use data for calibration"&CRLF&
" D - Halt execution of WRIST"&CRLF&
" G - Go read strain gages again"&CRLF&
" R - Resolve forces and moments"&CRLF&
" S - Save data set on disk"&CRLF&
" T - Terse output"&CRLF&
" X - ResOlve at external location"&CRLF&
" ? - Print this message"&CRLF)
ELSE IF EQU(LINED,"G") THEN ASKAGAIN←FALSE
ELSE IF EQU(LINED,"D") THEN ASKAGAIN←DONTSTOP←FALSE
⊃ SET OUTPUT TERSE/FULL MODE3
ELSE IF EQU(LINED,"A") THEN TERSE←FALSE
ELSE IF EQU(LINED,"T") THEN TERSE←TRUE
⊃ USER WANTS TO SET NEW DATA OFFSET;
ELSE IF EQU(LINAD,"B") THEN
BEGAN
FOR I←1 STEP 1 UNTIL 8 DO
BEGIN
BASE[I]←AVER[I];
IBASE[I]←READINGS[1,I];
END;
OUTSTR("New data base offset set"&CRLF);
ASKAGAIN←FALSE;
END
⊃ RESOLVE FORCES AND MOMENTS AT AN EXTERNAL LOCATION;
ELSE IF EQU(LINED,"X") THEN
BEGIN
OUTSTR("Type Dx,Dy,Dz = ");
ANS ← INCHWL;
DX ← REALSCAN(ANS,DUM);
DY ← REALSCAN(ANS,DUM);
DZ ← REALSCAN(ANS,DUM);
MPRIME[4,2]←-DZ;
MPRIME[4,3]←DY;
MPRIME[5,1]←DZ;
MPRIME[5,3]←-DX;
MPRIME[6,1]←-DY;
MPRIME[6,2]←DX;
END
⊃ FORCE AND MOMENT COMPUTATION;
ELSE IF EQU(LINED,"R") THEN
IF ¬ISCAL THEN
OUTSTR("NO CALIBRATION DATA"&CRLF)
ELSE BEGIN "RESOLVE"
REAL ARRAY F[1:6],FPRIME[1:6];
SETFORMAT(8,2);
FOR I←1 STEP 1 UNTIL 6 DO
BEGIN
F[I]←0.0;
FOR J←1 STEP 1 UNTIL 8 DO
F[I]←F[I]+M[I,J]*(READINGS[1,J]-IBASE[J]);
END;
TYPEFORCE(F);
FOR I←1 STEP 1 UNTIL 6 DO
BEGIN
FPRIME[I]←0.0;
FOR J←1 STEP 1 UNTIL 6 DO
FPRIME[I]←FPRIME[I]+MPRIME[I,J]*F[J];
END;
OUTSTR(CRLF&"FORCE/MOMENTS RECOMPUTED AT ("&CVF(DX)&
","&CVF(DY)&","&CVF(DZ)&")"&CRLF);
TYPEFORCE(FPRIME);
ASKAGAIN←FALSE;
END "RESOLVE"
⊃ SAVE DATA ON DISK FILE;
ELSE IF EQU(LINED,"S") THEN
BEGIN "SAVEIT"
INTEGER CHAN;
OUTSTR("OUTPUT COMMENT =");
LODED(COM1&CR);
COM1←INCHWL;
CHAN←3;
OPEN(CHAN,"DSK",0,2,2,DUM,DUM,DUM);
LOOKUP(CHAN,"FORCAL.DAT",DUM);
ENTER(CHAN,"FORCAL.DAT",DUM);
QUICK_CODE
UGETF 3,DUM;
END;
OUT(CHAN,COM1&CRLF&OUTBUF&CRLF&FF);
RELEASE(CHAN);
END "SAVEIT"
⊃ USE DATA FOR FORCE CALIBRATION, PRINT CURRENT DATA;
ELSE IF EQU(LINED,"C") THEN
BEGIN "CALIB"
OUTSTR("CURRENT CALIBRATION DATA:"&CRLF&
" TEST # FORCES AND MOMENTS"&CRLF);
SETFORMAT(8,3);
FOR I ← 1 STEP 1 UNTIL 6 DO
BEGIN
ANS←CVS(I)&" ";
FOR J ← 1 STEP 1 UNTIL 6 DO
ANS←ANS&CVF(F[I,J]);
OUTSTR(ANS&CRLF);
END;
⊃ REPLACE OLD DATA WITH NEW;
OUTSTR("REPLACE DATA SET (0=NONE) = ");
ANS ← INCHWL;
DSET←INTSCAN(ANS,DUM);
IF DSET≠0 THEN
BEGIN
ANS←"";
FOR I ← 1 STEP 1 UNTIL 6 DO
ANS←ANS&CVF(F[DSET,I]);
OUTSPR("NEW FORCES/MOMENTS =");
LODED(ANS&CR);
ANS ←INCHWL;
FOR I ← 1 STEP 1 UNTIL 6 DO
FKDSET,I]←REALSCAN(ANS,DUM);
FOR I ← 1 STEP 1 UNTIL 8 DO
EPS[DSET,I]WCAVER[I];
END;
⊃ ASK IF THE CALIBRATION MATRIX IS TO BE COMPUTED;
OUTSTR("COMPUTE NEW CALIBRATION MATRIX (Y,N)? ");
ANS←INCHWL;
IF EQU(ANS,"Y") THEN
BEGIN
SOLVER(MI,EPS,F);
PINVERSE(M,MI);
ISCAL←PRUE;
END;
⊃ SAVE NEW CALIBRATION ON THE DISK?;
OUTSTR("SAVE NEW MATRIX ON THE DISK (Y,N)? ");
ANS←INCHWL;
IF EQU(ANS,"Y") THEN
BEGIN
CHAN←3;
OPEN(CHAN,"DSK",0,0,2,120,DUM,DUM);
ENTER(CHAN,"FORCAL.CAL",DUM);
SETFORMAT(15,7);
FOR I←1 STEP 1 UNTIL 6 DO
FOR J ← 1 STEP 4 UNTIL 5 DO
BEGIN "PLINE"
MES←"";
FOR K ← J STEP 1 UNTIL J+3 DO
MES←MES&CVE(M[I,K])&" ";
OUT(CHAN,MES&CRLF);
END "PLINE";
OUT(CHAN,CRLF&CRLF&"CALIBRATION MATRIX: "&GETTIM);
RELEASE(CHAN);
END;
END "CALIB";
END "DATALOOP";
END "MAIN";
⊃ EXIT CLEANLY;
OUTSTR("I SURE HOPE THE #@!## IS CALIBRATED!!!!"&CRLF);
END "WRIST"
COMMENT ⊗ VALID 00004 PAGES TLKEF6.FAI
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE TLKEF6
C00004 00003 START OF EXECUTABLE CODE
C00008 00004 [LOCAL STORAGE AREA]
C00011 ENDMK
C⊗;
TITLE TLKEF6
INTERNAL TLKEF6
;"TLKEF6" IS A SAIL CALLABLE PROCEDURE FOR READING THE FORCE SENSING WRIST
;STRAIN GAGES FROM A PROGRAM THAT RUNS ON THE PDP11/45. A SAMPLE
;SAIL CALL IS AS FOLLOWS:
;
; ERROR←TLKEF6(INTEGER ARRAY READINGS);
;WHERE
; ERROR = 0 IF "TLKEF6" WAS SUCCESSFUL, ≠0 OTHERWISE
; READINGS = 10x8 ARRAY IN WHICH THE STRAIN GAGES READINGS ARE RETURNED
;
;THIS ROUTINE TYPES IT'S OWN ERROR MESSAGES ON THE TTY.
;DEFINITIONS
P←17 ;PUSH STACK REGISTER
MASLOC←40000 ;MASTER NUMBER IN ELF
DATADD←40001 ;START ADDRESS TO READ DATA FROI ELF
MASTER←10567 ;CHECK NUMBER FROM ELF IF DONE READING
DBUFL ←=80 ;NUMBER OF WORDS TO TRANSFER FROM THE ELF
;START OF EXECUTABLE CODE
TLKEF6: SETZ 1, ;CLEAR ERROR FLAG
MOVEM 16,HOLD+16 ;SAVE THE REGISTERS
HRRZI 16,HOLD
BLT 16,HOLD+15
;INTIALIZE THE ELF AND CLEAR THE MASTER NUMBER. THIS INSURES THAT
;WE READ CURRENT DATA
IOPUSH 1, ;CALLER MIGHT WANT THIS CHANNEL
JRST [ OUTSTR CM0 ;IOPDLOV MESSAGE
JRST ERR ]
INIT 1,17 ;INITIALIZE THE ELF
SIXBIT /ELF/
0
JRST [ OUTSTR CM1 ;ERROR RETURN
ERR: AOS HOLD+1 ;RETURN ERROR VALUE
JRST TLKDNE ]
GETSTS 1,1 ;GET THE ELF STATUS WORD
TRNE 1,777700 ;CHECK FOR ERROR CONDITION
JRST [ OUTSTR CM2 ;INDICATE STATUS ERROR
JRST ERR ]
MTAPE 1,MASADR ;ZERO MASTER NUMBER
JRST [ OUTSTR CM3 ;ERROR RETURN
JRST ERR ]
;WAIT TILL ELF COLLECTS THE DATA
MOVEI 3,=10 ;TRY READING ELF DATA 10 TIMES
READLP: SETZ 1, ;SLEEP BEFORE TRYING AGAIN
SLEEP 1,
MTAPE 1,DNEADD ;GET THE DONE WORD FROM THE ELF
JRST [ OUTSTR CM6 ;ERROR RETURN
JRST ERR ]
MOVE 2,DNEWRD ;LOAD VALUE INTO REGISTER
JUMPG 2,ELFDNE ;BRANCH IF THE ELF SIGNALS DONE
SOJG 3,READLP ;REPEAT IF MORE TIME LEFT
OUTSTR CM4 ;ELSE TELL OPERATOR ELF TOOK TOO MUCH TIME
JRST ERR
;TRANSFER THE DATA BACK TO THE MAIN PROGRAM IF ALL WENT WELL
ELFDNE: CAIE 2,MASTER ;MAKE SURE WE GOT THE RIGHT MASTER NUMBER
JRST [ OUTSTR CM7 ;SIGNAL ERROR
JRST ERR ]
MOVE 2,-1(P) ;GET ADDRESS TO TRANSFER DATA
SOJ 2, ;DECREMENT ARRAY POINTER
HRLI 2,-DBUFL ;SET POINTER TO TRANSFER DATA
MOVEM 2,INLST
USETI 1,GAGE ;SET UP INPUT STRAIN GAGE DATA
IN 1,INLST ;READ IN A BLOCK OF DATA
JRST .+2 ;NORMAL RETURN
JRST [ OUTSTR CM8 ;ERROR RETURN
JRST ERR ]
;RETURN TO CALLING PROGRAM
TLKDNE: IOPOP 1, ;RELEASE THE ELF & RESTORE CHANNEL 1
JFCL ;JUST CANNOT HAPPEN
HRLZI 16,HOLD ;RESTORE THE REGISTERS
BLT 16,16
SUB P,[2(2)] ;POP ARGUMENTS OFF STACK
JRST @2(P) ;RETURN
; [LOCAL STORAGE AREA]
HOLD: BLOCK 17
;I/O DATA AREAS
GAGE: 400004,,400000+DATADD ;MODE AND ADDRESS FOR "IN" OF STRAIN GAGE DATA
INLST: 0 ;PT. TO DATA ARRAY
0
MASADR: 003000,,MASLOC ;CLEAR MASTER WORD
0
DNEADD: 002004,,MASLOC ;MODE AND ADDRESS FOR MASTER DONE WORD
DNEWRD: 0 ;VALUE OF DONE WORK
;OUTPUT STRINGS
CM0: ASCIZ/IOPDLOV WHEN TRY TO SAVE CHANNEL 1 FOR "ELF"
/
CM1: ASCIZ/CANNOT INIT "ELF"
/
CM2: ASCIZ/"ELF" STATUS WORD INDICATES ERROR CONDITION
/
CM3: ASCIZ/UNABLE TO ZERO MASTER NUMBER IN "ELF"
/
CM4: ASCIZ/"ELF" NOT TRANSFERING STRAIN GAGE READINGS
/
CM5: ASCIZ/BAD READ FROM "ELF" DURING POSITION DATA TRANSFER
/
CM6: ASCIZ/ELF READ ERROR WHILE WAITING FOR ADC READING TO COMPLETE
/
CM7: ASCIZ/ELF MASTER NUMBER INCORRECT, CAN'T READ THE DATA
/
CM8: ASCIZ/ERROR IN TRANSFERING STRAIN GAGE DATA
/
END
COMMENT ⊗ VALID 00017 PAGES IO.PAL
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 IO - TELETYPE IO AND STRING MANIPULATION ROUTINES
C00006 00003 "INSTR" - VT05 INPUT ROUTINE
C00009 00004 "HOLD" - VT05 ROUTINE TO TEMPORARILY SUSPEND PRINTING
C00010 00005 "RELSCN"- STRING TO FLOATING POINT NUMBER ROUTINE
C00013 00006 [CONTINUATION OF "RELSCN"]
C00016 00007 [CONTINUATION OF "RELSCN"]
C00019 00008 "INTSCN"- STRING TO INTEGER NUMBER ROUTINE
C00021 00009 "CLRCMA"- ROUTINE TO CLEAR COMMA BREAK CHARACTER FROM STRING
C00022 00010 "FORMAT"&"RSTFOR" - ROUTINES TO SET AND RESTORE OUTPUT FORMAT
C00024 00011 "CVF" - FLOATING POINT NUMBER TO "F" FORMAT STRING ROUTINE
C00027 00012 "CVE" - FLOATING POINT NUMBER TO "E" FORMAT STRING ROUTINE
C00030 00013 [CONTINUATION OF "CVE"]
C00032 00014 "CVG" - FLOATING POINT NUMBER TO "E" OR "F" FORMAT STRING
C00034 00015 "PRTF" - PRINTING ROUTINE USED BY "CVF", "CVE", & "CVG"
C00037 00016 "CVI"&"CVO" - INTEGER NUMBER TO ASC STRING
C00040 00017 LOCAL STORAGE AREA
C00044 ENDMK
C⊗;
;IO - TELETYPE IO AND STRING MANIPULATION ROUTINES
.TITLE IO
;***NOTE: ALL OF THE REGISTER DEFINITIONS REQUIRED BY THESE ROUTINES****
;*** CAN BE FETCHED BY DOING A ".INSRT HALHED[HAL,HE]" ********
;"CRLF" IS A SUBROUTINE FOR TYPING OUT ONE CARRIAGE RETURN AND LINE FEED
;ON THE TELETYPE.
CRLF: MOV #CRLFX,SG
JSR PC,TYPSTR
RTS PC
CRLFX: .BYTE 15,12,0,0
;"TYPSTR" OUTPUTS A STRING, ENDING WITH A ZERO CHARACTER. A POINTER TO
;THE START OF THE STRING MUST BE LOADED INTO R5. CALLED USING THE PC.
TYPSTR: MOV R0,-(SP)
BR 2$
1$: JSR PC,TYPCHR ;TYPE THIS CHARACTER
2$: MOVB (SG)+,R0 ;GET A CHARACTER
BNE 1$ ;END OF LINE?
MOV (SP)+,R0
RTS PC ;Done
TYPCHR: TST OUTSW ;VT05 or console?
BEQ TYPCH1
TSTB KBOS ;VT05: Is it available?
BPL TYPCHR ;No
MOVB R0,KBOR ;Output a byte to it.
CMP #12,R0 ;Was it a line feed?
BNE TYPRET ;If not thatcode, then done.
CLR R0 ;Otherwise, output 3 nulls.
JSR PC,TYPCHR ;
JSR PC,TYPCHR ;
BR TYPCHR ;Direct jump; it will return to caller.
TYPCH1: TSTB OREG ;Console: Ready?
BNE TYPCHR ;No.
MOVB R0,OREG ;Yes. Output a byte to it.
MOV #1,172566 ;Wake up pdp10 by generating interrupt
TYPRET: RTS PC ;Return.
;"INSTR" - VT05 INPUT ROUTINE
;STRING BYTE POINTER MUST BE IN SG. A CARRIAGE RETURN IS ASSUMED TO
;BE THE ACTIVATION CHARACTER. A RUB OUT IS A DELETING BACKSPACE
;CHARACTER. AT THE COMPLETION OF THIS ROUTINE A NULL CHARACTER IS
;PLACED IN THE INPUT STRING. SG IS LEFT UNCHANGED.
;REGISTERS USED:
;
; SG PASSES ARGUMENT AND IS NOT MODIFIED
INSTR: MOV R0,-(SP)
MOV SG,-(SP)
IN2: TST OUTSW ;VT05 OR CONSOLE?
BEQ CONSIN
TSTB KBIS ;TEST IF KEYBOARD READY
BEQ IN2 ;WAIT TILL IT IS
MOVB KBIR,R0 ;GET A CHARACTER
BR GOTCAR
CONSIN: MOV IREG,R0 ;BYTE FROM PDP10?
BEQ IN2 ;NO
CLR IREG
GOTCAR: BIC #177600,R0 ;MASK OFF - MAKE IT 7 BITS
CMP R0,#177 ;COMPARE TO BS CHARACTER
BNE IN3 ;SKIP IF ITS NOT
CMP SG,(SP) ;CHECK IF ANY CHARACTERS IN BUFFER
BEQ IN2 ;FORGET BACK SPACE IF NO CHAR.
DEC SG ;REMOVE LAST CHARACTER IN BUFFER
MOV SG,-(SP)
MOV #DBS,SG ;PERFORM A DELETING BACKSPACE
JSR PC,TYPSTR
MOV (SP)+,SG
BR IN2
IN3: CMP R0,#15 ;COMPARE TO CR CHARACTER
BEQ IN4 ;CONTINUE READING IF ITS NOT A CR
CMP R0,#40 ;CHECK IF CHARACTER LEGAL
BLT IN2 ;IGNOR IF IT IS
MOVB R0,(SG)+ ;SAVE THE CHARACTER
JSR PC,TYPCHR ;ECHO CHARACTER
BR IN2 ;CONTINUE READING
IN4: MOVB R0,(SG)+ ;END OF STRING,PUT IN A CR
CLRB (SG) ;PUT IN A NULL CHARACTER
JSR PC,CRLF ;TYPE CR/LF
MOV (SP)+,SG
MOV (SP)+,R0
RTS PC ;RETURN
DBS: .BYTE 10,40,10,0
;"HOLD" - VT05 ROUTINE TO TEMPORARILY SUSPEND PRINTING
;IF A CHARACTER HAS BEEN TYPED ON THE VT05 KEYBOARD, THIS ROUTINE GOES
;INTO A BUSY WAIT LOOP UNTIL ANOTHER CHARACTER IS TYPED. BOTH CHARACTERS
;ARE LOST. IF NO CHARACTER HAS BEEN TYPED, THIS ROUTINE RETURNS
;IMMEDIATELY.
;REGISTERS USED:
;
; NONE
HOLD: TSTB KBIS ;TEST IF CHARACTER TYPED
BEQ HLDDNE ;RETURN IF NO CHARACTER
CLRB KBIR
TSTB KBIS ;ELSE WAIT TILL ANOTHER CHARACTER TYPED
BEQ .-4
CLRB KBIR
HLDDNE: RTS PC
;END OF "HOLD"
;"RELSCN"- STRING TO FLOATING POINT NUMBER ROUTINE
;THE FLOATING POINT NUMBER MUST BE OF THE FORM SIII.DDDESXX WHERE S IS
;THE SIGN OF THE NUMBER, III IS THE INTEGER FIELD, DDD IS THE DECIMAL
;FIELD, AND SXX IS THE EXPONENT AND ITS SIGN. THE LENGTH OF EACH
;FIELD IS VARIABLE BUT ONLY THE FIRST 8 DIGITS ARE USED IN COMPUTING
;THE F.P. NUMBER. EMPTY FIELDS ARE PERMITTED AND ALL LEADING SPACES
;AND ZEROS ARE IGNORED. THE LOCATION OF THE FIRST BYTE OF THE STRING
;MUST BE LOADED INTO SG BEFORE CALLING "RELSCN". AFTER EXECUTION,
;THIS ROUTINE LEAVES THE F.P. NUMBER IN REGISTER AC0 AND SG POINTS TO
;THE BYTE FOLLOWING THE LAST DIGIT. THE C BIT IS USED TO INDICATE AN
;ERROR CONDITION. IF NO NUMBER WAS FOUND BEFORE ENCOUNTERING A COMMA
;OR NULL CHARACTER, THE C BIT IS SET OTHERWISE THE C BIT IS CLEARED ON
;EXITING THIS ROUTINE. "RELSCN" IS CALLED USING THE PC.
;REGISTERS USED:
;
; AC0,SG PASS ARGUMENTS, NO OTHER REGISTERS AFFECTED
;"DIGIT" CHECKS FOR ASC DIGIT AND CONVERTS TO INTEGER IF IT IS
.MACRO DIGIT NOTDIG
CMP R0,#60 ;COMPARE TO ASC ZERO
BLT NOTDIG ;SKIP IF OUT OF RANGE
CMP R0,#71 ;COMPARE TO ASC 9
BGT NOTDIG ;SKIP IF OUT OF RANGE
BIC #60,R0 ;MASK OUT ASC BASE
.ENDM
;"CKSIGN" CHECKS FOR A - OR + CHARACTER AND SETS SIGN APPROPRIATELY
~∀9≠βπ¬<Aπ↔'%∂⊂→αM~N&≡pb:RNL:92NL:84(L~6@%≠)M %&↓⊂K\_yd⎇∩∧%2∩∧9λ∃∀ :HU⊂h!_$-λ→~5≤LyaPPL9ZJ≠VUE∪⊃↔4≤DX92∧Ld ∃%~λ∀α∩j$λ4D
%aPPL)hPLuJ9∀<P⊃↔4-D~D∧L2 ~E~∧iz@hP→→dλM9_tpH↔8Te≤T
4-"
9∀<R itrm(Z$xh!_%∩→~5≤LyaPRtYhDhh!Q#]≥H~%"∧xdα∃∀YJ4≤r!Q hU(YE≤≤g!∀l⎇a~#αbU
5αH↔:4
∀T
$,<~:D-∃1Q Llza∃∪
EU¬≥α⊃Q Llza∃∪∩EU¬≥α⊃Q"αα∧∧αLYz`M∪5ERE≥¬⊃⊂hR∧∧ααα↓_4e⊂~&"H↔:$-≤ZD∧$Ly~B∧≤zYe h!→T⎇0∀6∩e∪1⊃∪]≤ZD∧$,9→T b
tLuDλdd qQ `J∧∧¬\≤yjDLuX~DL|d t2α*(Te≤9d%hh!Q Llza∩~k∃J#λH↔9∀t$_8∃$* ir∧$_y∃%~λYd≤⎇YjD-∀XAPR_9E∀0__3H↔84d,~$¬$DT e,l(Z"∧ 8:Thh!_4e⊂→Z4L<a⊃∪\
::Tl* X∀u$~:4
¬ z4M$~hPhPQ'5∧L94¬-αλ∀∧≤D~(∀≥$Z$∧ tDλ4D,94∧4⎇$
4L<aQ hU _4[P→Yu4⊂∃
4:J5J#K: ∀≤Z
Zα∧
λ9∧
∀_:D-⊂Q!∃%≥A~#λH↔84D,94∧L2λI∀<MDλTt≤zYe$-(X@hP_(UλL9 4$8⊃↔5≤\~∧∧L2
J%,(Q!∀≤]9_tpM _4Zd9 4$:IZ4L<a↔4≤DX92∧4z λ¬4∪tH¬T∀r1ia"C"G8r⊃0i4∩1Hλ9⊂4P*(u⊃4D 4h⊂$λ∩1r*A"C"H9∩q⊃g!1∩1i~α0r 8∀α"':rr4∧
∪h⊂i q∀λ _H∪SjD⊂(⊃ _r5β!!353λa5⊃3EH0lα!↔s53
D⊃∩1i~λ∀u)T⊂V(ε⊗β"B(~rα(f%∀Lα!↔s53
I4∪⊗$ 3Q⊃+∧⊂V(εA"B0(H⊃B1λy∀u
&
+⊂(6α.p(Hλ∃∩λT⊃KT¬d∃∪hλ_pu3!QB0s
$λλλ∧
L(λ∧∧α".i→Q∩0h~⊃(⊃ _r5λλYPsu)j⊃4Q(A"B4jXHλλ∧∧λm
&B".hH0tQ)X3UλλI1r5∧λsu3JA"B2IZα4∩(9b".hyh⊃q*D⊂3SjI⊃4Hλ9⊂4P(:⊃4C!!"Npiλ0rh _H∃∩λT⊂r⊂*(0u⊃*$∩4hλ∀⊃⊃0i→03λ
r3U↓QC"Pi q∀∞A_s4α$6-K∀F↓".piy4⊂4HT⊂r⊂*(0u⊃*$∃∪hλH0r3(→λ∀∃↓QB0SHQ4SSj)"".j9r4λ _H∪SjD⊃ T¬a"Hλ∧∧λλα*Juα4F1".piλ0rh _H⊃⊃(9303∧
∪r3JD⊂3∀HX1⊗(
85β"A_Q4"*)StS!⊃.r1D
Q4q*D∃∩∩*4∪54jD⊂Q(λ∀∃∩⊃$λ3Qλ xH∃∩λT∪03JEC"B(9∀B4F!".tjH4Uλλ9u3U →Qh⊃J(0u∩)yP3λλI1r5
1"B0iJB4La⊃.r3HI0p5λT⊃ T¬d∀q5↓QB0s
!4L"!↔r3Q _p5⊃$λ∩1r*D⊃3Piz3U⊃*(1β"A→S4α* 0rb!↔qshλx5λ⊂)iu∩⊃*$⊂r⊂*(0u⊃*!"C"G8stTHXuλ∪JY0Q4DλStH
uq4D qH∃λYH∩1Dλ∩1r*Jh⊃SjYQβ"AQTSSj).B5
:α4L!⊃.prλXrh∩(d⊃∩1i~∀h⊃Iz3Qβ!!0SQ!_r∩q+↓".ti94λ∩(d∪SsHQ"B5
:α4La⊃.prλXrh∩(d⊃⊃0i→03λ
r3U∧
q5β!!0SQ!_r∩q+↓".q yUλ∪IzS03 ≠Q(∩(d∪ShλET C!$λλλ↓→53⊃A~⊃3S
:
∀LE∃⊂0l↓↔pstJ(0uλλH0r3(→λ∀∪i→Uβ"AQNprλXrh∩(d⊃(∀i_sH⊃)hsu3JH4Q1↓QC"Pi q6∞A_s0α$6,
+
&α".h9s4⊂*((∃∪dλ(⊂rλ~P0uλZC"B()Q"0i q∪B!↔trr*∧∩1H iuλ⊃!QB5∀jA4L ⊂λ⊂∧D]Pd"aeH$c⊂'∪P"$cRj)P!⊃c'i"H"FE∧P"hDbV!gεEαf"#∧U"g&)U⊗ aXα]ibjλ aX≡LP$c⊂⊃l('g⊃g*⊂!∃j⊂''H"$cdU)FEβ∧P⊂⊂⊗agg*∩g*`j∩gc⊂'Q⊂⊃)"S)ag⊃↔FEεEαaf)∧T_DD]Rg"$aPj"P"∩cdj)H"g!gUg*"i⊃bεE"V!g≥∧Pf)∧bTdcg∧B]`iiUdbP"V('g"S*⊂('Tdj$k⊃FE∧aS)∧i→BD]af⊃`i⊂"V('g"S*⊂ aPjfjf⊂j'iεB∧fgk⊂∧T)cJUV)_α]cbjλ'"l*λ!d i⊂aj"iβE∧aeTdcg∧T$aY⊗⊃$cY⊗⊃idcgα]ad"PeP#'T⊂)dcS⊂!d T aj"TεE($PY≥∧fSk!∧T∀cTUV∀_∧]iRcg⊂$S!gjg∃"i"b ⊂#bjλ'"l*λ!d i εE"$QY≥∧b∩cdj∧S'i&DB]bl*∀ aj⊂⊃$cdjλεE∧fUf∧QXL↔⊗)→BD]fjS*⊂"l∀'g⊂)⊃cP!,H_X↔εB∧`b"αi_⊗) DD]`Q"⊂"$Qdj⊂*∪P"l(∪g"g*λ)"cFB∧e&hαh$aYαD]cgH#bj⊂⊂g'j$⊃i⊂!d⊂i aj⊃iεEεB''i&N∧j)jαbidcS∧D]aR"aeP∀dcg⊂∪c⊂"l∀'g"g∃EQ .+4
NEG R3 ;COMPLEMENT EXPONENT IF - SIGN
ASH #2,R3 ;MULT. INDEX BY 4 FOR F.P. NUMBERS
MULF TENLST(R3),AC0 ;ADJUST EXPONENT OF NUMBER
JMP CDONE ;EXIT ROUTINE
;CHECK IF END OF STRING OR COMMA ENCOUNTERED
CHKDN: TST R0 ;COMPARE CHARACTER TO A NULL CHARACTER
BEQ CDONE ;EXIT IF IT IS, THIS IS THE END OF THE STR
CMP #54,R0 ;COMPARE TO ","
BEQ CDONE ;EXIT IF IT IS
TST R1 ;TEST IF ANY DIGITS YET
BLT PICK ;IF NONE, KEEP SCANNING
;NO MORE DIGITS - APPLY CORRECT SIGN TO NUMBER
CDONE: DEC SG ;POINT TO BREAK CHARACTER
TST MSIGN ;TEST SIGN OF MANTISSA
BEQ .+4
NEGF AC0 ;COMPLEMENT NUMBER IF SIGN NEGATIVE
TST R1 ;TEST IF NO NUMBER ENCOUNTERED
BEQ .+4
SEC ;SET C REGISTER IF NO NUMBER FOUND
MOV (SP)+,R3 ;RESTORE REGISTERS
MOV (SP)+,R2
MOV (SP)+,R1
MOV (SP)+,R0
RTS PC ;RETURN
;END OF "RELSCN"
;"INTSCN"- STRING TO INTEGER NUMBER ROUTINE
;THE INTEGER NUMBER MUST BE OF THE FORM SIII WHERE S IS THE SIGN OF THE
;NUMBER, AND III IS THE INTEGER FIELD. ALL LEADING SPACES AND ZEROS
;ARE IGNORED. THE LGCATION OF THE FIRST BYTE OF THE STRING MUST BE
;LOADED INTO REGISTER SG BEFORE CALLING "INTSCN". AFTER EXECUTION,
;THIS ROUTINE LEAVES THE INTEGER NUMBER IN R0 AND SG POINTS TO
;THE BYTE FOLLOWING THE LAST DIGIT. THE C BIT IS USED TO INDICATE AN
;ERROR CONDITION. IF NO NUMBER WAS FOUND BEFORE ENCOUNTERING A COMMA
;OR NULL CHARACTER, THE C BIT IS SET. ALSO, IF THE INTEGER NUMBER IS
;TOO LARGE, THE C BIT IS SET, OTHERWISE THE C BIT IS CLEARED ON EXITING
;THIS ROUTINE. "INTSCN" IS CALLED USING THE PC.
;REGISTERS USED:
;
; R0,SG PASS ARGUMENTS AND ARE ALTERED
; AC0 IS GARBAGED
INTSCN: JSR PC,RELSCN ;CONVERT STRING NUMBER TO FLOATING POINT
BCC .+4
RTS PC ;EXIT IF NO NUMBER FOUND
STCFI AC0,R0 ;ELSE CONVERT NUMBER TO INTEGER
CFCC ;TRANSFER CODITIONAL CODES
RTS PC ;RETURN
;END OF "INTSCN"
;"CLRCMA"- ROUTINE TO CLEAR COMMA BREAK CHARACTER FROM STRING
;"CLRCMA" CAN BE CALLED FOLLOWING "RELSCN" TO ADJUST THE STRING
;POINTER IN SG TO SKIP OVER THE COMMA CHARACTER WHICH IS USED
;TO SEPARATE NUMBERS IN THE SAME INPUT STRING. SG MUST BE
;POINTING AT THE INPUT STRING. NO OTHER REGISTERS ARE EFFECTED.
CLRCMA: TSTB (SG) ;CHECK IF AT END OF STRING
BNE .+4
RTS PC ;RETURN IF END OF STRING
CMPB #54,(SG)+ ;COMPARE TO COMMA CHARACTER
BNE CLRCMA ;BRANCH IF IT ISN'T
RTS PC
;END OF "CLRCMA"
;"FORMAT"&"RSTFOR" - ROUTINES TO SET AND RESTORE OUTPUT FORMAT
;THE TOTAL NUMBER OF CHARACTERS TO BE WRITTEN (WIDTH) SHOULD BE
;LOADED INTO R0 AND THE NUMBER OF DECIMAL DIGITS (DIGITS) SHOULD
;BE LOADED INTO R1 BEFORE CALLING THIS ROUTINE. IN ALL CASES,
;WIDTH SHOULD BE GREATER THAN OR EQUAL TO DIGIT+2. "FORMAT" IS
;CALLED BY USING THE PC.
;REGISTERS USED:
;
; R0,R1 PASS ARGUMENTS
; NO OTHER REGISTERS AFFECTED
FORMAT: MOV WIDTH,OLDW ;SAVE THE OLD WIDTH
MOV DIG,OLDD ; AND DIG
SUB #2,R0 ;SUBTRACT SPACES FOR SIGN AND . FROM WIDTH
MOV R0,WIDTH ;SAVE WIDTH OF I/O STRING - 2
MOV R1,DIG ;SAVE THE NUMBER OF DECI. DIGITS
CMP R0,R1 ;CHECK TO SEE THAT WIDTH.GE.DIGIT+2
BGE NFER ;SKIP IF SPACE ALLOWED, ELSE CORRECT
MOV SG,-(SP) ;TYPE OUT ERROR MESSAGE
MOV #FERM,SG
JSR PC,TYPSTR
MOV (SP)+,SG
MOV R1,WIDTH ;SET WIDTH=DIG+2
NFER: RTS PC ;RETURN
FERM: .ASCIZ /
FORMATTING ERROR
/
.EVEN
;"RSTFOR" - ROUTINE TO RESTORE LAST FORMAT
;THE PREVIOUS FORMAT BECOMES THE CURRENT FORMAT. THE CURRENT
;FORMAT IS LOST FOREVER. "RSTFOR" IS CALLED IN USING THE PC.
;REGISTERS USED: NONE
RSTFOR: MOV OLDW,WIDTH ;RESTORE WIDTH
MOV OLDD,DIG ;RESTORE DIG
RTS PC ;RETURN
;END OF "FORMAT" &"RSTFOR"
;"CVF" - FLOATING POINT NUMBER TO "F" FORMAT STRING ROUTINE
;"CVF" - THE STRING GENERATED BY THIS ROUTINE IS SIMILAR TO "F" FORMAT
;IN FORTRAN. IT IS ASSUMED THAT THE NUMBER TO BE CONVERTED IS IN
;REGISTER AC0 AND SG CONTAINS A POINTER TO THE FIRST BYTE OF THE
;OUTPUT STRING. THE NUMBER OF CHARACTERS WRITTEN SHOULD FIRST BE SET
;IN A CALL TO "FORMAT", ELSE THE DEFAULT VALUES ARE USED. IF THE
;INTEGER PART OF THE NUMBER EXCEEDS THE FORMAT LIMITS THE FIRST
;CHARACTER WRITTEN IS A ">". AFTER COMPLETION, "CVF" LEAVES A NULL
;CHARACTER FOLLOWING THE NUMBER STRING. REGISTER SG IS LEFT POINTING
;AT THE NULL CHARACTER.
;REGISTERS USED:
;
; SG,AC0 PASS ARGUMENTS AND ARE ALTERED
; AC1 IS GARBAGED
CVF: MOV R1,-(SP) ;SAVE REGISTER
MOV WIDTH,R1 ;GET THE TOTAL NUMBER OF CHAR TO BE WRITTEN
SUB DIG,R1 ;DETERMINE THE MAG. OF THE M.S. DIGIT
MOV R1,PT ;NOW HAVE # OF DIGITS BEFORE DECIMAL POINT
ASH #2,R1 ;X 4, USE AS INDEX INTO F.P. TABLE
DIVF TENLST(R1),AC0 ;NORMALIZE NUMBER TO BETWEEN 0 AND .99999999
MOV WIDTH,R1 ;TOTAL # OF DIGITS TO R1
MOV R2,-(SP) ;SAVE THE REGISTERS
MOV R3,-(SP)
JSR PC,PRTF ;TYPE OUT THE DIGITS
MOVB #0,(SG) ;PUT A NULL CHARACTER AFTER THE STRING
MOV (SP)+,R3 ;RESTORE THE REGISTERS
MOV (SP)+,R2
MOV (SP)+,R1
RTS PC ;RETURN
;END OF "CVF"
;"CVE" - FLOATING POINT NUMBER TO "E" FORMAT STRING ROUTINE
;"CVE" - SAME OPERATION AS "CVF" EXCEPT THAT OUTPUT IN FORTRAN "E" FORMAT
CVE: MOV R1,-(SP)
MOV R2,-(SP) ;SAVE THE REGISTERS
MOV R3,-(SP)
CLR EXPON ;RESET EXPONENT COUNT
MOV #1,PT ;SET COUNT TO PRINT 1 NUMBER BEFORE DECIMAL PT
MOV WIDTH,R1 ;SET COUNT FOR TOTAL NUMBER OF DIGITS TO BE SENT
SUB #4,R1 ;ADJUST FOR EXPONENT
TSTF AC0 ;CHECK IF NUMBER IS ZERO
CFCC ;TRANSFER CONDITIONAL CODES TO CPU
BEQ EPRT ;START PRINTING IF NUMBER IS 0.0
STF AC0,NUM ;GET THE NUMBER TO BE CONVERTED
DEC EXPON ;ADJUST EXPONENT FOR PRINTING 1 INT. DIGIT
MOV NUM,R2 ;LOAD THE EXPONENT AND MSB OF THE NUMBER
BIC #100000,R2 ;CONVERT TO ABSOLUTE VALUE
SUB #150,R2 ;ADJUST EXPONENT DOWN
BGE .+4
CLR R2 ;LEAVE IT POSITIVE
MUL #233,R2 ;USE EXPONENT AND MSB AS INDEX INTO TEN TABLE
CMP R2,#76. ;COMPARE TO 1.0@38
BLE .+6
MOV #76.,R2 ;IF LARGER, REPLACE BY 1.0@38
SUB #38.,R2 ;SHIFT INDEX INTO RANGE OF -38 TO +38
ADD R2,EXPON ;ADJUST EXPONENT COUNT
ASH #2,R2 ;MULT INDEX BY 4 FOR FLOATING POINT NUMBERS
DIVF TENLST(R2),AC0 ;NORMALIZE NUMBER INTO RANGE 0.0 TO 0.9999
STF AC0,AC1 ;GET ABSOLUTE VALUE OF NUMBER
ABSF AC1
CMPF TENLST,AC1 ;CHECK IF NUMBER LESS THAN 1.0
CFCC ;TRANSFER CONDITIONAL CODES TO CPU
BGT EPRT ;IF ITS BETWEEN 0.0 AND .99999, GO TO PNTF
DIVF TEN,AC0 ;ELSE MULT. BY 0.1 AND ADJUST EXPONENT
INC EXPON
[CONTINUATION OF "CVE"]
EPRT: JSR PC,PRTF ;GO PRINT MANTISSA
MOVB #105,(SG)+ ;PUT A "E" CHAR INTO THE STRING
MOVB #53,(SG)+ ;ASSUME EXPONENT POSITIVE A OUTPUT A "+"
MOV EXPON,R3 ;TEST SIGN OF EXPONENT
BGE XPRT ;SKIP IF POSITIVE
MOVB #55,-1(SG) ;REPLACE "+" WITH "-"
NEG R3 ;MAKE EXPONENT POSITIVE
XPRT: CLR R2 ;CLEAR FOR DIVISION
DIV #10.,R2 ;SEPARATES TENS AND UNITS DIGIT
BIS #60,R2 ;CONVERT TO ASC AND PUT IN I/O BUFFER
MOVB R2,(SG)+
BIS #60,R3
MOVB R3,(SG)+
MOVB #0,(SG) ;PUT IN A NULL CHARACTER
MOV (SP)+,R3 ;RESTORE THE REGISTERS
MOV (SP)+,R2
MOV (SP)+,R1
RTS PC ;RETURN
;END OF "CVE"
;"CVG" - FLOATING POINT NUMBER TO "E" OR "F" FORMAT STRING
;"CVG" - DETERMINES IF THE NUMBER IN AC0 CAN BE WRITTEN BY "CVF", IF
;IT CAN, THEN CVF IS CALLED, ELSE THE NUMBER IS PRINTED USING "CVE".
CVG: MOV R1,-(SP)
LDF AC0,AC1 ;COPY THE NUMBER
CFCC ;TRANSFER THE CONDITIONAL CODES TO CPU
ABSF AC1 ;CONVERT NUMBER TO ABSOLUTE VALUES
BEQ RUNF ;IF NUMBER = 0.0, EXECUTE CVF
MOV DIG,R1 ;GET THE NUMBER OF DECIMAL DIGITS TO BE TYPED
ASH #2,R1 ;MULT BY 4 TO USE A FLOATING POINT INDEX
MULF TENLST(R1),AC1 ;CHECK IF NUMBER SMALLER THAN 1.0@-DIG
CMPF TENLST,AC1 ;COMPARE TO 1.0
CFCC ;TRANSFER CONDITIONAL CODES TO CPU
BGT RUNE ;IF LESS THAN 1.0@-DIG, PRINT USING CVE
MOV WIDTH,R1 ;GET THE TOTAL NUMBER OF DIGITS TO BE PRINTED
ASH #2,R1 ;USE THIS AS A F.P. INDEX
NEG R1
MULF TENLST(R1),AC1 ;CHECK IF GREATER THAN WIDTH-DIG LONG
CMPF TENLST,AC1 ;COMPARE TO 1.0
CFCC ;TRANSFER CONDITIONAL CODES
BGE RUNF ;IF TOO LARGE, USE CVE
RUNE: JSR PC,CVE
MOV (SP)+,R1
RTS PC
RUNF: JSR PC,CVF
MOV (SP)+,R1
RTS PC
;END OF "CVG"
;"PRTF" - PRINTING ROUTINE USED BY "CVF", "CVE", & "CVG"
PRTF: TSTF AC0 ;TEST THE SIGN OF THE NUMBER
MOVB #40,MSIGN ;ASSUME SIGN POSITIVE
CFCC ;TRANSFER THE CONDITIONAL CODES TO CPU
ABSF AC0 ;CLEAR THE SIGN OF THE NUMBER
BGE .+10
MOVB #55,MSIGN ;IF NEGATIVE PUT IN "-" SIGN
MODF TEN,AC0 ;COMPUTE M.S. INTEGER DIGIT
CLR R3 ;INDICATE SIGN NOT YET WRITTEN
DIGLP: TST PT ;CHECK IF TIME TO PRINT DECIMAL POINT
BNE GETDG ;SKIP IF NOT
TST R3 ;HAVE WE PRINTED SIGN YET?
BNE WTDP ;SKIP IF WE HAVE
MOVB MSIGN,(SG)+ ;ELSE PRINT SIGN BEFORE DECIMAL POINT
INC R3 ;INDICATE SIGN PRINTED
WTDP: MOVB #56,(SG)+ ;PRINT DECIMAL POINT
GETDG: STCFI AC1,R2 ;SAVE M.S. INTEGER DIGIT
CFCC ;CHECK FOR NUMBER TOO LARGE T@≡A%≥) ∂∃%∪5
4∀∪¬π ∪π⊃↔M4~∃)=→∂
t%β %βεbY¬ε`∩∩m∪ A)]≡A→βI∂
XAA+(A∪PA¬βπ,A)∨∂∃)⊃ $4∀∪≠∨⊃ ∪) 9)⊂Yβ `∩w'
β→
A⊃∨/≤A¬≥λA)I2A∪≥Q ∂ %%5∪≥∞↓β∂β∪8~∀β∪9ε∪$b$∩w!%%≥(A∨U(A∨≥∀A≠∨%∀A ∪∂%(~∀∪%≥ε∪!P∩∩w'!∪
(A⊃ π∪≠¬_A!∨%≥(A)<A!+(↓∪≤A a)%αA⊃∪∂∪(4∀∪)'P∪$f∩$wπ⊃
⊗A∪ ↓'∪∂≤↓β≥λA⊂] \A¬→% β⊃2A/%%)) ≤4∀∪¬ D∪∂ )⊃∞∩∩w≥≡Aπ⊃∃π⊗A∪_A∪≤AIβ≥∂
↓∪ A≥=(A/%%)) ≤4∀∪π→H∪$f∩$wπ→ ¬$A'∪≥≤Aβ≥⊂Aλ] 8~∀∪'U∧∩Fd1'∞∩∩mβ ∃+M(A¬3Q
A!∨%≥) $4∀∪∃≠@∪∂ )⊃∞∩∩w≥≡Aπ⊃∃π⊗A∪_A∪≤AIβ≥∂
↓β∂β∪8~∃π⊃-'4t∪Q'(@@@A$d@@@@@@@@@@@wQ '(A%≥) ∂∃$~∀∪ →(∪)=→∂
∩$w∪ AQ∨≡A→¬%∂
X↓∂≡A'
β→
A¬∂β∪≤4∀∪π≠@∪$dX r\∩∩mπ⊃ π,A∪ A1 '&AQ⊃β≤@d~∀∪¬≥(∪)∨1∂
∩∩m'πβ→∀A∪ A≥%ββ)∃$A)⊃¬≤@r~(@@@@@∪≠∨⊃ ∪) 8Yβε`$∩w')¬%(Aπ=≠!+)%≥∞A≥∃1(A∪9) ∂ HA ∪∂%(~∀∪Q'(∪$L∩∩w⊃¬-
A/∀A!%∪9) λAM∪∂≤Ae (}~(∪¬≥
%' )¬L∩∩w'-∪ A∪_A/
A!β-
~(∪)'(%$d∩∩mπ⊃ π,A∪ A1 β ∪9∞A5 I≡~∀∪ "∪/Q' ∩∩m∪ A∪PA∪&A≥≡A/%%)
Aα↓'!βπ∀Aπ⊃βIβπ) H~∀∪≠=-∧∪≠M∪∂≤X!'∞RV$w
∪%M(Aπ⊃¬%βπ)∃$XA≥=*A!%%≥(A'%∂≤~∀%∪≥ε∪Hf∩∩w%≥ ∪π¬)
A'%∂≤A!I∪≥) ⊂~∃' Q¬&t∪ ∪&∩FX`Y$d$∩w' PAβ'ε↓5 %≡↓¬β'
4∀∪∃≠@∪/)π ~∃/)M t∪≠=-∧∩FP`Y$d$∩w/%%)
Aα↓'!βπ∀Aπ⊃βIβπ) H~∃/)
⊂t∪≠=-∧∪$HXQ'∞$V∩w!T CHARACTER IN I/O BUFFER
DEC PT ;DECREMENT DECIMAL POINT COUNT
SOB R1,DIGLP ;DONE WITH CHARACTERS?
RTS PC ;RETURN
;END OF "PRTF"
;"CVI"&"CVO" - INTEGER NUMBER TO ASC STRING
;"CVI"&"CVO" CONVERT THE INTEGER LOADED INTO R0 INTO A ASCII STRING
;AND APPEND THE NUMBER STRING TO THE STRING POINTED TO BY SG. SG IS
;LEFT POINTING AT A NULL CHARACTER. A SAMPLE CALLING SEQUENCE
;FOLLOWS:
;
; MOV #NUM,R0 ;LOAD NUMBER TO BE CONVERTED
; MOV #STRG,SG ;POINT TO OUTPUT STRING
; JSR PC,CVI
;
;"CVI" DOES A DECIMAL CONVERSION, WHILE "CVO" WORKS IN BASE 8.
;REGISTERS USED:
;
; R0, SG PASS ARGUMENTS AND ARE ALTERED
CVI: MOV R2,-(SP) ;SAVE REGISTER
MOV #10.,R2 ;DO A DECIMAL CONVERSION
BR CVV
CVO: MOV R2,-(SP) ;SAVE REGISTER
MOV #8.,R2 ;DO A OCTAL CONVERSION
CVV: MOV R1,-(SP) ;SAVE REGISTER
TST R0 ;CHECK SIGN OF NUMBER
BGE ITISPL ;BRANCH IF POSITIVE
NEG R0 ;ELSE COMPLEMENT
MOVB #55,(SG)+ ;PUSH A "-" INTO STRING
ITISPL: JSR PC,DIVLP ;GO FORM STRING RECURSIVELY
CLRB (SG) ;POINT TO A NULL CHARACTER AT END OF STG
MOV (SP)+,R1 ;RESTORE REGISTERS
MOV (SP)+,R2
RTS PC ;ALL DONE
DIVLP: MOV R0,R1 ;POSITION NUMBER FOR DIVISIOF
CLR R0 ;CLEAR FOR DIVISION
DIV R2,R0 ;GET LSD
ADD #60,R1 ;OR ASC BASE
MOVB R1,-(SP) ;SAVE DIGIT
TST R0
BEQ .+6 ;SKIP IF ALL DONE
JSR PC,DIVLP ;REPEAT RECURSIVELY
MOVB (SP)+,(SG)+ ;PUT DIGITS IN STRING
RTS PC
;END OF "CVI"
;LOCAL STORAGE AREA
MSIGN: 0 ;SIGN OF CURRENT NUMBER
ESIGN: 0 ;SIGN OF EXPONENT
EXPON: 0
NUM: .WORD 0,0
WIDTH: 8. ;DEFAULT NUMBER OF CHARACTERS IN OUTPUT STRING
DIG: 3 ;DEFAULT NUMBER OF DECIMAL DIGITS
OLDW: 8. ;OLD VALUES OF WIDTH AND DIG
OLDD: 3
PT: 0 ;NUMBER OF DIGITS BEFORE DECIMAL POINT
;SYSTEM LINE BUFFERS
INBUF: .BLKW 42.
OUTBUF: .BLKW 42.
;TABLE OF F.P. DIGITS FROM 0.0 TO 9.0
DGLST: .WORD 0, 0, 40200, 0, 40400, 0, 40500, 0
.WOrD 40600, 0, 40640, 0, 40700, 0, 40740, 0
.WORD 41000, 0, 41020, 0
;TABLE OF POWERS OF TEN
.WORD 531,143735, 1410, 16352, 2252, 22045, 3124,126456
.WORD 4004,166075, 4646, 23514, 5517,130437, 6401,147263
.WORD 7242, 41140, 10112,151370, 10775,103666, 11636, 72322
.WORD 12506, 11006, 13367,113210, 14232,137025, 15101, 66632
.WORD 15761,144400, 16627, 16640, 17474,162410, 20354, 17113
.WORD 21223,111357, 22070, 73652, 22746,112625, 23620, 16575
.WORD 24464, 22334, 25341, 27023, 26214,136314, 27057,165777
.WORD 27733,163377, 30611, 70137, 31453,146167, 32326,137625
.WORD 33206, 33675, 34047(142654, 34721,133427, 35603, 11157
.WORD 364∀3(λbjLhbd~)) ≥) t∩]/=%λ∩@Lnfbh0bhlfDj@~∃Q ≥→'Pt∩]/=%λ∩@P`d``0@@@@`@~∃Q ≤t∩9/∨%λ$@hb`P`X@@@@`~(∩]/∨Iλ∩@hDnb`X@@@@@X@hdTndX@@@@`0@hfhLhX@h@```Xhhf`LX@j`@``~∀$]/∨%⊂∩@hjDlhX@Hd```0@hl`L`XbbLd``XhllnXXbfl@h`X@Pnjjl0@ljhT`~∀∩9/∨%λ$@j`hHjX@@DfnbXjbdnβ⊃1↓Q 1Y]1β)IEUαaEUI⊃!U1↓+→AIEc AIM#84(%u:>J⊂J↓UMY3)1EY≠↓QE1β)QUQ~a↓U]3)E1↓+)QEYb↓EU]λε"bβVf#3
F⊗# ∪vAPPJjyu∀ ∀εS; 6eBαβVVS~bεfββ %F∪#≠FF2bβfεc+*Dεs#≠V@ ∧εL-,f¬ -,fF
c"A∃UstHA(
LFF
k &εl-l¬D
LlFV+λ
FF MK∧εM $F5α_ZλL→Z⊗⊂
~X_~ ⊂~Z~L_FE∧K+gi"αP≠~[
~V⊂≠
[~≠⊗λ≠≠~XM⊗_Z~M_[V⊂
≠Z__K⊂→[J
Y⊗⊂≠L→~_F X≠ZλLεE∧W∃gi"∧H≠XXXLV_[XLXY⊗⊂
X[[@4, 67574, 72635,142656, 73505, 33431
.WORD 70366,102337, 75232, 114DhX@nXb``XDbfnb\X@nl\l`XbLln`d4∀∩]/=%λ∩@\nldl0@nfdLb~∀~(~∀w 9λA∨ E∪≡D↓!%∨∂Iβ~~∀→π∨≠5 ≥(@X@@A-¬→∪λ@@```p↓!β∂ L@@@@@A∪≥Q
βε]Aβ_~∃ A% εA!β∂∀@@A ∃'π%∪A)∪∨≤4∃ε``@`b@`@``b~)ε```@d@``@`d∩]Q∪)→
↓∪≥)
¬ε~∃ε@```h````L∪ βε↓) '(↓' π)%∨≤~∃ ````\@```@h∪β A) 'PA' πQ∪∨≤~)ε```@r@``@`j∪π=≥(\A= Aβ A%∨+Q∪≥
~)ε```D`@``@`l∪'U¬%&A¬≥λAπ1∨π⊗A%≥) %I+!(AI∨+)∪9
~∃ε@``bf````\∪' πQ∪∨≤AQ≡A% ¬λA
∨Iπ
A/I∪'(A¬≥λA%∃)+%≤↓∪≥
∨I≠β)∪=≤A)≡↓! b@~∃ε`@`bj@@```p%→∨πβ0A')∨Iβ∂
~)ε```DnA ≥⊃≠⊗~∃ ,v~∀_])∪Q→
A∪9)
βε4∀]∪≥M%(A⊃¬→⊃ λ9!β→7!β_Y⊃∃:~∀~(\zb`@`@@~(~∀]∪9'%(A%≡]!β16fY¬∃':~∀4∃ %βQ% ∩ztjf`@∩∩w HbbAα↓- π)=$@∩~) %¬)I ∩zzTfh@@$∩w $DbA∧AY π)∨H∩∩~∃⊃$bc&$zbln\n`@∩m $bb↓')β)U&A/∨Iλ@~∃⊃$bc≡$zbln\nd∩∩m $bb↓∨+)!U(A% ≥∪') H@~∃ Hbc∩∩tblnn\h@∩w⊃$bbA%≥!+(↓% ∂∪M) $@@~∃!¬≥∪π∧$zd``4∃ ≥β →
∩zP``∩∩m∪≥) I
βπ
↓ ≥β¬1
~∀~(wπ∨≠5+≥∪π¬)∪∨≥LA→∪≥,A)≡AA b`4∀~∃≠¬') $tzb`jXn~∃≠¬'→∨εtb```@`~∃
⊃β)αzD````H~∀~∀lAae←≥eCZA%]SiS¬YSuCQS←\~(~∀] Y ≤~∃M)β%(h∪% '∃(~∀∪5∨,@FD```YM ∩wS9SiSC1SuJAMiCGV4∀∪π→HA!&∩$wS]SQSCYSiJAae=GKgg=dAgi¬ikf~(@@@@@∪π→HAπ→↔
≥(∩w
YKCd↓GY←G,AeKO%giKeLZAie¬`AeKMiCeh4∀∪π→HAπ→↔M (~∀%π→$A
→↔&~(∪→
A&∩F`4∀∪≠∨X∩FrYH`∩∩wM (A)Q2A∨+Q!+(A→∨%≠βP~∀∪≠=,∩Fd1$b~∀%∃'$∪AεY
∨I≠β(~(∪≠∨,$Gπ→↔M $Yπ1↔)% $w' (↓π→∨π,A∪≥)∃%%+!PA%∨+Q∪≥
~(∪≠∨,$Ffh`1π→↔)I Vd~(@~∀w¬'⊗A∪_A βε↓∨$Aβ⊃εAπ⊃∃π⊗~∀~∀∪≠=,∩Gπ=~bY'≤∩wβ',A∪ A¬ εA∨HA βε4∀∪∃'H∪!εY≥ )≥+4~∀∪)M(∪$`4∀∪¬≥∀∪∪'β⊃ε~∀ ;DAC TEST SECTION
DACSEC: CLR DR11S ;SET DR11 DAC MODE
MOV #COM2,SG ;GET DAC CHANNEL
JSR PC,GETNUM
MOVB BRK(R0),R1 ;GET BRAKE MASK BIT
BIS #ENABLE,R1 ;ADD ON INTERFACE ENABLE BIT
MOV R1,BRKMSK
MOVB DNE(R0),R1 ;GET DONE BIT MASK
SWAB R1
MOV R1,DNEMSK
ASH #13.,R0
MOV R0,R3
MOV #COM3,SG ;CHECK IF POSITION OR TORQUE MODE
JSR PC,GETNUM
TST R0
BEQ ISCUR ;BRANCH IF CURRENT MODE
MOV #1,STPDNE ;ASSUME DONE MASK TO BE CHECKED
MOV #COM11,SG ;ASK IF DONE BIT TO BE CHECKED
JSR PC,GETNUM
TST R0
BNE WILCHK ;SKIP IF DONE BIT TEST REQUESTED
BR .+6
ISCUR: BIS #10000,R3 ;SET CURRENT MODE BIT
CLR STPDNE ;DON'T EVER STOP ON DONE CONDITION
WILCHK: MOV R3,DACCHN ;SAVE DAC CHANNEL
MOV #COM4,SG ;GET DC DAC VALUE
JSR PC,GETNUM
MOV R0,DACDC
MOV #COM5,SG
JSR PC,GETNUM ;GET DAC RAMP VALUE
MOV R0,DACCHG
CLR COUNT
CLR DR11S ;RESET DR11
CLR PDAC ;START AT BOTTOM OF RAMP
CLR PTIME ;INDICATE FIRST PASS THROUGH
MOV #10.,CLKSET ;SET CLOCK TO INTERRUPT EVERY 100USEC
MOV #111,CLKS
CLKWT: TST DNEMSK ;CHECK IF DONE BIT OF
BNE .+6
JMP RUG ;EXIT IF ALL DONE
TSTB KBIS ;ELSE CHECK IF SOMEONE HIT THE TTY
BEQ CLKWT ;LOOP TILL SOMETHING HAPPENS
CHR CLKS ;STOP THE DAC ROUTINE
JMP RUG
;ADC TEST SECTIOF
ISADC: MOV #2,DR11S ;SET DR11 ADC MODE¬
MOV #COM6,SG ;ASK IF TYPE OUT REQUESTED
JSR PC,GETNUM
MOV R0,TYPADC
MOV #COI7,SG ;SINGLE CHANNEL OR INDEX?
JSR PC,GETNUM
BIC #177\nlY$@~∀∪≠=,∪$`1∪∃ 04∀∪¬ D∪'≥∂
⊃≤4PJ6>XJ~R>B≤bI2N8h(&*≥⊂&B
e"fBN%⊂4(&≤bH&>$"⊗Z8hP&
HL
∩∞N%⊂4*Nt:∞"9PJ6>XJ~∞>5BbN≤%\:⊗Qα≥"εJRLr≥α∞D
::⊗`h(&*≥⊂&B
d:⊗R:,h4(&∀J %
9]MQαbI@4PJ6>XM⊃A2ε$~∞"8KZNεZ*αNRε∃!α∞" r:⊗0hQ4)\
∩
αdz>@4R4*ε$~N@%'!∀l⎇a∀3∩dJ&∪
_↔:$-
XZ5"∧_H2∧≤yjd-∃9→tph(_D≤eπ!∀l⎇a_∀$≤9 bd%&⊗∀xK:(U
,Z:B∧ H4∧≤|jhU∃≤→y`hP→Yu0J6⊗βαrJ&⊂K]x→∃"∧Iyuα∧9zTu Q*t MIJβPL)~@J≠&εαd%&⊗∃_h!_$t(__D≤$hQ⊂K\*(∀t≤∧ ∀2∧Iyd(h!_D,_~&⊂hP_(t(Mx→∃$e↓⊃∪]∀ZλT
" _b¬≥I→Db∧Yz$*¬I→T*∧HXe h!→T⎇0∀84|k∃J48h!→%≥⊂~λ2e%~
5%⊂Q!∀Tm↓~%,8Q(∀$≤IhSPLYz`L%&⊗∀Je&↓∪\<ZD∧ $4
$, I→d8h!~E≥ ~K∃∧ H1⊂K\9λT≤Z _b¬%~λR∧⎇ZD¬∀-~Y∃∀,AQ L∀Z⊃∀<-Ik¬ H↔:4\M∧ ∀2∧iqPPLYz`J≤→x%,2J8phS1_∀$ ∀6#β#¬eE∪Q!∀U≥!~∧~d:i⊂HK89tu4Z*B¬$βh⊂*8r2#!!33uH!(m ¬E∀qj%1"B3)zPB(fF
∀hu*c"A→3uPA∀m ¬
qj*aQB33jhB(mε¬
∀qe∃c"B(9∀PB%
qj#!!33uA∀r3pJXK∀qa↔u⊗4λT∪u5∧
Q01 →Qc"A→TtB*λk∃⊗*
u∀C!!2TtA~⊂k⊂j)⊃C"@↓GpssJEH∪qDλ1⊂h
)u5∩)h#"C!(q5∪K
∞B5
:α23HKα".h9⊃0rd 1H∩)h⊃6∩)hh∪tD
r3QiH(⊂rλ→SQ3↓QB0Q*⊃5∀uλIQ#"A_ss")x⊃⊃5Ia".piλ0rh _H⊃∩*:∪⊂6$ 3H∀I_r∃λ zH∪⊃(jλ∀⊂**λ∪qD
ptQ(YC"B((4"0(H⊂∧b,αD]ieRh⊂$cλ&gk$S#P*'H&"c*βE∧fgU∧Qi$Qd*⊗)QFE∧e∀i∧h!K*,h)U)εE Q"$b,∞∧`b"αdg", b!aR'∧]h∪dg*⊂∃'P'"V*⊂!d⊂g'"fβE∧afT∧f`l⊂d'⊗ Q!ad'α]ad"PeP$cλ+i hλ i'jS"⊂*$SbFE∧P#bDj∀j"'"BD]ieRh⊂$cλ)j$f∪⊂'eFB∧af)α`b!aR'∧D]Qf)bP∀j i*λ+dj$λ!d g∪"f⊂_λ c`dSεE∧aS)∧gb⊃"k'εB∧j)jαj,h Q!DD]Pd"aeH$c⊂*⊗h"P'Uj⊂)"Tjdi"QεE∧a⊃hDj)U"'"FB∧fgkαQj'h )cFEαe)i∧T!V*,T)j)εB*)j"∪"]∧j∀j!∧eP$iDDNad"aRP$c⊂∃*_~P∩$jεEαa"hDPb!f(βE∧e&T∧i*cCEβ≥ija∀)P g⊃⊂!f'PeP$g∃"i)*T*⊂)'Uj$g"CE⊂εE⊃bj'*S]∧e)T∧h!V∃,h)j∀εE∧fSk∧QdSa*c⊗∀cFE∧R)i∧h⊂V$g)U)εE∧Sgk∧QRga*c )cFEαe)i∧T!V$g∃)agεB∧i*)Bh!FEλεEεE⊂f%ibT≥∧fgU∧b aQ!V)_α]cbjλ" aP∪jj(*U⊂+ f∃bFE∧Pb"∧h⊃ aV) εE∧fSk∧i_ )_FEαa#bDK∃Z∧DNad"aRP$c⊂∩g⊂) S#bFEαg"cDT_FE∧Pfh∧QM___⊗∀_FE∧P#bDk⊂f'eDB]a) S!d⊂$Q⊂'eFB∧fgkαb ab⊂V)_∧Nbf)bH)j i∃⊂'k"T⊂ j⊂⊃!P+ S*bFEαfgk∧Q aad⊃T(" PFE∧g⊃cDh"⊂aFE≥CE≥DfSk∧QXK")_XTD]jiQP*$$TP*'P∀lg!P∪g⊂+d⊃g⊂*"Tj$g#CE≥DfSk∧a)∩fieV⊃)_XgBFE≥FB+ f'R]∧a$PDQX[L___⊗∀_εE∧P$iDb⊂aad' )_∧]Pb"⊂"⊂aP!d⊂g'"fβE∧af∀∧b)_LiFE∧Sgk∧i ⊗")_LgFE∧Pb"∧b⊂aad#K(" aCE∧j)U∧h*$SbDD]Pd"aeH$c⊂'∪j⊂#$T)j⊂(⊂iiP*∩)'jcRεE∧a∪"Dad∩b'"DB]a) S!d⊂$Q⊂''jλ( iiH'g"FB∧fgkαQXV"∀_XiDNbf)bH)bj⊂⊂) ebH&gb"CE∧fgU∧a)%SieV"∀_XgDNj*i'λ'c#⊂⊂) ebH g"⊂⊃g a&⊃P$g*⊃i# aQFE∧fSk∧QXK(*$fQD]dg⊃$a`j⊃P"g"λ'c⊂#∩i)j⊂∀ iiFB∧i*$CE!d%Q'"]∧Sgk∧QLV")_LiD]cQj⊂ i∪P)j U*iP!∩j)P⊂λ⊂⊂εEαfgk∧Q)_XdK)_∧FB⊂∧a$U∧Qh S$aa⊗∀_∧]aR"aeP∩c⊂( S$aP!∃j*'gλ$$jεB⊂∧a"TDij(∩j∧D]Tj'h⊂∀bi+$Pdg#P∩c⊂!*U*'g⊂∩$jεEαj)j∧Tj("'⊃DD]aR"aeP∩c⊂$gλ) g#QP!d"Pedg#H* ∂ BE DONE
BNE .+4
RTI ;BETURN IF NOT CHECKING REQUIRED
BIT DNEMSK,R0 ;CHECK IF IN RANGE
BNE IN@%9∂
~∀%π→$∪
∨+≥(∩∩wπ1 β$A%≤A%β9∂
Aπ=+≥(~(∪%)∩$∩∩w a∪(A∪_A')∪1_A≥∨PA ∨≥∀~∃∪≥I≥∂
t%∪≥ε∪
∨+≥(∩∩w∪9π% ≠∃≥(A≥U≠¬ $↓∨ A'∃#+ ≥
A)∪5 &@~(∪π≠ $FfYπ=+≥(@$wπ⊃
⊗A∪ ↓β(A→∃β'(@LA)∪≠∃&~∀∪ →
∩\,h~∀∪I)∩~∃M)!∪(h@∪π→H∪π→↔L∩∩w 1'
A'Q∨ A)!
Aπ→=π⊗~∀%π⊃$∪⊃≥ ≠',~∀∪≠=,∩Fb1 $bcL∩w' PA)⊃
↓¬%β↔∃&~∀∪
→$∪ Hbc≡~(∪%)∩4∀_w'
)∪∨≤↓)≡A%∃βλA
=%π
A]%∪'(↓β≥λAI )+%8A∪≥
=%≠β)%∨≤A)<A! D`~∀~)
∨%π∀t~∃ h∪≠∨,$G≠β'Q $Y≠¬'→∨ε$w∪≥ %πβ)
↓% β dA)≡AI βλA→∨%π
↓/%∪'P~∀~∀m/β∪(↓→∨∨ ↓→∨∨↔%≥∞AβPAπ∨≠5β≥λA →∨π⊗↓
%∨~↓! b@~∀~∃])→ t@A)'P∪↔¬∪L∩∩wπ! π⊗A% Aβ≥e∨≥
A!∪(A-P`jA↔∃3¬∨βIλ~∀∪ "∪π!↔≠'(4∀∪π→I∧∪↔¬%$~∀∪)≠ ∪%U∞∩∩w∃1∪(AQ≡A P~∃π⊃-≠'(t%π≠ ∩
≠β')∃$Y≠βM→∨ε∩mπ⊃ π,A∪ A9≡A∨≥∀Aβ→)∃% λAQ⊃
A~9≥+≠¬∃$A3 P~∀∪¬∃"∪/)1 ~∀∪5∨,∩G→ β)α1$b~∀%≠∨,∩ b`\YHd∩∩wI βλ@D`A' Q&A∨ ↓ β)α4∀~∃'∃)→ t%≠∨,∩ p\Y$L∩∩w %∂⊃(AM)%β∪8A∂β∂∃&A∪≤↓β→_~(∪π→$%$h∩∩m')β%PA/∪) Aπ⊃β9≥ _@@~∀~∃I → h@∪≠∨X∩FdY⊃$bc&$w% #U '(A¬ εAπ=≥- %M∪∨≤~(@@@@@∪≠∨X∪$hY⊃$bc≡$~∀∪≠=,∩Fb@`\Y$@∩w/β%(A→∨= Aπ∨U≥(~∃]→ t@@∪¬∪P∩Fd`@Y $bE&~∀∪ ≥
∪π9- ≥
$∩w¬%¬≥π⊂A% A ∨9
~∀∪⊃ ε∪$@~∀∪¬≥
∪/→@@@@@$∩w% A β(A% A')%→_A≠=%
A)%≠
A→∃
(~∀%≠∨,∩
π∨~r1'∞~∀%∃'$∪AεY)3A')$~(∪∃≠ %%+∞~)π≥- 9
t∪≠=,∪ $Dc∩Y$@∩w∂ PAβ ε↓% β %≥∞~∀%β λ∩ d`hp8Y$`~(∪≠∨,%$`XQHbRV∩m'β-
↓% β %≥∞~∀%∪≥ε∪Hh∩∩wA∨∪≥(↓)≡A≥∃1(Aπ!β≥≥ 0~∀∪'=∧∪$f1% →@∩w% A β(AU≥)∪_↓ ∨≥
4∀∪'∨λ∪$dYM )→ 4∀∪¬$% ∩∩wI ! βP~∀ ;LOCAL STORAGE
ODDEVN: 0
DACCHN: 0
DACDC: 0
DACCHG: 0
PDAC: 0
TYPADC: 0
ADCCHN: 0
INDX: 0
MAXCHN: 31.
BRK: .BYTE 1,2,4,10,20,40,100,0
DNE: .BYTE 1,2,4,10,20,40,100,0
BRKMSK: 0
DNEMSK: 0
STPDNE: 0
COUNT: 0
PTIME: 0
;OUTPUT STRINGS
COM1: .ASCIZ /DAC OR ADC(0:1) = /
COM2: .ASCIZ /DAC NUMBER (0:7) = /
COM3: .ASCIZ /CURRENT OR POSITION MODE (0:1) = /
COM11: .ASCIZ /CHECK DONE BIT (0=NO,1=QES) = /
COM4: .ASCIZ /DAC DC VALUE (-2048 : 2047) = /
COM5: .ASCIZ /DAC CHANGE EVERY 100 USEC = /
COM6: .ASCIZ /TYPE ADC READINGS (0:1)? = /
COM7: .ASCIZ /SINGLE CHANNEL OR INDEX (0:1) = /
COM8: .ASCIZ /ADC CHANNEL (0:31) = /
COM9: .ASCIZ /**ERROR** NO ADC DONE SIGNALED
/
TOP: .BYTE 35,10,10,10,0
TOPCLR: .BYTE 35,35,37,37,37,10,10,10,0
RIGHT: .BYTE 32,10,10,10,30,30,30,30,30,30,30
.BYTE 30,30,30,30,0
IOBUF: .BLKW 100.
PBUF: .BLKW 300.
.END START